{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  WumpusLite.FontLoader.UntypedAfmParser
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Simplistic AFM file parser
--   
--------------------------------------------------------------------------------


module WumpusLite.FontLoader.UntypedAfmParser
  (
  
    AfmParser

  , header

  ) where



import Text.Parsec hiding ( (<|>) )
import Text.Parsec.String
import Text.Parsec.Language ( emptyDef )
import Text.Parsec.Token ( GenLanguageDef(..) )
import qualified Text.Parsec.Token as P

import Control.Applicative
import qualified Data.Map as Map

type AfmParser a = GenParser Char () a


type Header = Map.Map String String


header :: AfmParser (String,Header)
header = (\i xs -> (i, Map.fromList xs)) 
           <$> startFontMetrics <*> manyTill headerLine startCharMetrics

headerLine :: AfmParser (String,String)
headerLine = (,) <$> identifier <*> manyTill (noneOf "\n") (char '\n')

startFontMetrics :: AfmParser String
startFontMetrics = reserved "StartFontMetrics" *> versionNumber


startCharMetrics :: AfmParser Int
startCharMetrics = reserved "StartCharMetrics" *> int

versionNumber :: AfmParser String
versionNumber = lexeme $ many1 (digit <|> char '.')

--------------------------------------------------------------------------------
-- Lexer


lexer :: P.TokenParser ()
lexer = P.makeTokenParser $ emptyDef
  { identStart        = letter
  , identLetter       = letter
  , caseSensitive     = True
  , commentLine       = "Comment"
  , reservedNames     = [ "StartFontMetrics"
                        , "StartCharMetrics"
                        , "EndCharMetrics" 
                        , "EndFontMetrics"
                        ]
                        
  }


identifier      :: AfmParser  String
identifier      = P.identifier lexer

int             :: AfmParser Int
int             = P.integer lexer >>= return . fromIntegral


reserved        :: String -> AfmParser ()
reserved        = P.reserved lexer


lexeme          :: AfmParser a -> AfmParser a
lexeme p        = P.lexeme lexer p